home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Best of MacTutor - S…e Code for Volumes 1 to 5
/
The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin
/
Source Code
/
#48 (Sep 89)
/
Zoundz Source
/
MyFileStuff.Pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-04-28
|
6KB
|
220 lines
unit MyFileStuff;
interface
uses
PrintTraps, Sound, MyGlobals, Message, MySound;
procedure doSave;
procedure doSaveAs;
procedure OpenFile;
procedure doOpen;
implementation
const
SFPutLeft = 82;
SFPutTop = 50;
myType = 'ZZDC';
myCreator = 'KCZZ';
var
SFPutPt: Point;
theReply: SFReply;
refNum, resRef: integer;
bytes: longint;
title: str255;
theLength: longint;
theErr: OSErr;
theItem: integer;
oldHandle: Handle;
function HandleError (theStr: Str255; theError: OSErr; chk, chksum: integer; CloseIt: boolean): boolean;
var
STemp: str255;
begin
if (theError <> noErr) then
begin
A_Message(theStr, '', '', '', theItem);
if CloseIt then
begin
theErr := FSClose(refNum);
theErr := FlushVol(nil, VolRefNum);
end;
HandleError := true;
end
else if (chk <> chksum) then
begin
A_Message(theStr, 'Checksum Error', '', '', theItem);
if CloseIt then
begin
theErr := FSClose(refNum);
theErr := FlushVol(nil, VolRefNum);
end;
HandleError := true;
end
else
HandleError := false;
end;
procedure doSave;
begin
if VolRefNum = 0 then
begin {bad volume reference number}
A_Message('Bad Volume Number', '', '', '', theItem);
Exit(doSave);
end
else {good volume reference number}
begin
theErr := FSOpen(FileName, VolRefNum, refNum);
if HandleError('Could Not Open File', theErr, 0, 0, false) then
Exit(doSave)
else {file was open ok}
begin
theErr := SetFPos(refNum, FSFromStart, 0);
if HandleError('Could Not Open File Position', theErr, 0, 0, true) then
Exit(doSave)
else {ready to go}
begin
bytes := sizeof(DocRec);
theLength := bytes;
theErr := FSWrite(refNum, bytes, ptr(MyDoc));
if HandleError('Trouble Writing To File', theErr, bytes, theLength, true) then
Exit(doSave);
end;
end; {of file open ok}
theErr := FSClose(refNum);
theErr := FlushVol(nil, VolRefNum);
theErr := SetVol(nil, VolRefNum);
CreateResFile(FileName);
resRef := OpenResFile(FileName);
if resRef = -1 then
begin {could not be opened}
A_Message('Could not write sound to', FileName, '', '', theItem);
Exit(doSave);
end
else {ready to write out sound}
begin
OldHandle := GetResource('snd ', 9000);
if OldHandle <> nil then
begin {existing sound to remove}
RmveResource(OldHandle);
DisposHandle(OldHandle);
UpdateResFile(resRef);
end;
CreateSndResource(MyDoc^.StartValue, MyDoc^.EndValue);
AddResource(MyHandle, 'snd ', 9000, FileName);
UpdateResFile(resRef);
CloseResFile(resRef);
DisposHandle(MyHandle);
DisposHandle(Handle(MySoundHandle));
end;
end;{ of good vol ref num}
end; {of doSave}
procedure doSaveAs;
begin
SetPt(SFPutPt, SFPutLeft, SFPutTop);
GetWTitle(MyWindow, title);
SFPutFile(SFPutPt, 'Save Zoundz as…', title, nil, theReply);
if theReply.good then
begin
theErr := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
if theErr <> noErr then {duplicate or problem}
begin
if theErr = dupFNerr then
begin {duplicate}
theErr := FSDelete(theReply.fname, theReply.vRefNum);
if theErr <> noErr then
begin {cannot delete file}
A_Message('Cannot Delete File.', '', '', '', theItem);
Exit(doSaveAs);
end;
theErr := Create(theReply.fname, theReply.vRefNum, myCreator, myType);
if theErr <> noErr then
begin {error in creating after deleting duplicate}
A_Message('Cannot Create', theReply.fname, '', '', theItem);
Exit(doSaveAs);
end;
end
else { a problem}
begin
A_Message('Cannot Create', theReply.fname, '', '', theItem);
Exit(doSaveAs);
end;
end {duplicate or problem}
else {ready to save}
begin
VolRefNum := theReply.vRefNum;
FileName := theReply.fname;
SetWTitle(MyWindow, FileName);
theErr := FlushVol(nil, VolRefNum);
doSave;
end; {ready to save}
end; {good reply}
end;
procedure OpenFile;
begin
theErr := FSOpen(FileName, VolRefNum, refNum);
if HandleError('Could Not Open File', theErr, 0, 0, false) then
Exit(OpenFile)
else {file was open ok}
begin
theErr := SetFPos(refNum, FSFromStart, 0);
if HandleError('Could Not Open File Position', theErr, 0, 0, true) then
begin
VolRefNum := 0;
Exit(OpenFile);
end
else {ready to go}
begin
bytes := sizeof(DocRec);
theLength := bytes;
theErr := FSRead(refNum, bytes, ptr(MyDoc));
if HandleError('Trouble Reading File', theErr, bytes, theLength, true) then
begin
VolRefNum := 0;
Exit(OpenFile);
end;
end;
end; {of file open ok}
theErr := FSClose(refNum);
theErr := FlushVol(nil, VolRefNum);
MyWindow := nil; {Make sure other routines know we are not valid yet}
NoteText := '1';
NumToString(MyDoc^.StartValue, StartText);
NumToString(MyDoc^.EndValue, EndText);
NumToString(MyDoc^.freq[1], FreqText);
NumToString(MyDoc^.amp[1], AmpText);
NumToString(MyDoc^.dur[1], DurText);
NumToString(MyDoc^.timbre[1], TimbreText);
NoteIndex := 1;
DrawTool := 1;
MySoundHandle := nil;
MyHandle := nil;
end;
procedure doOpen;
var
theTypes: SFTypeList;
begin
SetPt(SFPutPt, SFPutLeft, SFPutTop);
theTypes[0] := myType;
SFGetFile(SFPutPt, 'Open Zoundz file…', nil, 1, theTypes, nil, theReply);
VolRefNum := 0;
if theReply.good then
begin
VolRefNum := theReply.vRefNum;
FileName := theReply.fName;
OpenFile;
end;
end;
end.